!--------------------------------------------------------------------------------------------------!
! Copyright (C) by the DBCSR developers group - All rights reserved                                !
! This file is part of the DBCSR library.                                                          !
!                                                                                                  !
! For information on the license, see the LICENSE file.                                            !
! For further information please visit https://dbcsr.cp2k.org                                      !
! SPDX-License-Identifier: GPL-2.0+                                                                !
!--------------------------------------------------------------------------------------------------!

MODULE dbcsr_methods
   !! Base methods on DBCSR data structures
   USE dbcsr_array_types, ONLY: array_data, &
                                array_release
   USE dbcsr_btree, ONLY: btree_delete, &
                          btree_new
   USE dbcsr_data_methods, ONLY: dbcsr_data_get_size, &
                                 dbcsr_data_release
   USE dbcsr_kinds, ONLY: default_string_length
   USE dbcsr_mpiwrap, ONLY: mp_comm_free
   USE dbcsr_ptr_util, ONLY: memory_deallocate
   USE dbcsr_types, ONLY: &
      dbcsr_1d_array_type, dbcsr_2d_array_type, dbcsr_data_obj, dbcsr_distribution_obj, &
      dbcsr_imagedistribution_obj, dbcsr_imagedistribution_type, dbcsr_memtype_type, &
      dbcsr_mp_obj, dbcsr_mutable_obj, dbcsr_type, dbcsr_type_antihermitian, &
      dbcsr_type_antisymmetric, dbcsr_type_complex_4, dbcsr_type_complex_8, &
      dbcsr_type_hermitian, dbcsr_type_invalid, dbcsr_type_no_symmetry, dbcsr_type_real_4, &
      dbcsr_type_real_8, dbcsr_type_symmetric, dbcsr_work_type
#include "base/dbcsr_base_uses.f90"

   IMPLICIT NONE

   PRIVATE

   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbcsr_methods'

   INTEGER, PUBLIC, SAVE :: dbcsr_matrix_counter = 111111

   PUBLIC :: dbcsr_release
   PUBLIC :: dbcsr_valid_index
   PUBLIC :: dbcsr_release_locals
   PUBLIC :: dbcsr_distribution, &
             dbcsr_get_matrix_type, dbcsr_get_data_type, dbcsr_get_replication_type, &
             dbcsr_row_block_sizes, dbcsr_col_block_sizes, &
             dbcsr_nblkrows_total, dbcsr_nblkcols_total, dbcsr_nfullrows_total, &
             dbcsr_nfullcols_total, dbcsr_nblkcols_local, dbcsr_nblkrows_local, &
             dbcsr_max_row_size, dbcsr_max_col_size, &
             dbcsr_get_index_memory_type, dbcsr_get_data_memory_type, &
             dbcsr_name, dbcsr_setname, dbcsr_get_data_size, &
             dbcsr_use_mutable, dbcsr_wm_use_mutable, dbcsr_has_symmetry, &
             dbcsr_get_nze, dbcsr_nfullrows_local, dbcsr_nfullcols_local
   PUBLIC :: dbcsr_get_data_size_used
   PUBLIC :: dbcsr_col_block_offsets, dbcsr_row_block_offsets
   PUBLIC :: dbcsr_data_area
   PUBLIC :: dbcsr_get_num_blocks

   PUBLIC :: dbcsr_blk_row_size, dbcsr_blk_column_size, &
             dbcsr_blk_row_offset, dbcsr_blk_col_offset

   PUBLIC :: dbcsr_destroy_array
   PUBLIC :: dbcsr_image_dist_init, dbcsr_image_dist_hold, dbcsr_image_dist_release

   PUBLIC :: dbcsr_mutable_init, dbcsr_mutable_new, dbcsr_mutable_destroy, &
             dbcsr_mutable_release, &
             dbcsr_mutable_instantiated

   PUBLIC :: dbcsr_distribution_release
   PUBLIC :: dbcsr_mp_release, dbcsr_mp_grid_remove

   ! For the 1-D and 2-D arrays

   INTERFACE dbcsr_destroy_array
      MODULE PROCEDURE dbcsr_destroy_1d_array, dbcsr_destroy_2d_array
   END INTERFACE

CONTAINS

   PURE FUNCTION dbcsr_valid_index(matrix) RESULT(valid_index)
      !! Returns whether the index structure of the matrix is valid.

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! verify index validity of this matrix
      LOGICAL                                            :: valid_index
         !! index validity

      valid_index = matrix%valid
   END FUNCTION dbcsr_valid_index

   RECURSIVE SUBROUTINE dbcsr_release(matrix)
      !! Releases a reference for a DBCSR matrix
      !! If there are no references left, the matrix is destroyed.

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! DBCSR matrix

      matrix%refcount = matrix%refcount - 1
      IF (matrix%refcount .EQ. 0) THEN
         CALL dbcsr_destroy(matrix)
      END IF
   END SUBROUTINE dbcsr_release

   RECURSIVE SUBROUTINE dbcsr_destroy(matrix, force)
      !! Deallocates and destroys a matrix.

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! matrix
      LOGICAL, INTENT(IN), OPTIONAL                      :: force
         !! force deallocation

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_destroy'
      INTEGER                                            :: error_handle
      LOGICAL                                            :: force_all

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, error_handle)
      force_all = .FALSE.
      IF (PRESENT(force)) force_all = force
      IF (.NOT. force_all .AND. matrix%refcount .NE. 0) &
         DBCSR_WARN("You should not destroy referenced matrix.")
      IF (force_all .AND. matrix%refcount .GT. 1) &
         DBCSR_WARN("You should not destroy referenced matrix.")
      IF (force_all .OR. matrix%refcount .EQ. 0) THEN
         IF (ASSOCIATED(matrix%wms)) &
            DBCSR_WARN("Destroying unfinalized matrix")
         IF (ASSOCIATED(matrix%index)) THEN
            CALL memory_deallocate(matrix%index, matrix%index_memory_type)
         END IF
         CALL dbcsr_data_release(matrix%data_area)
         CALL array_release(matrix%row_blk_size)
         CALL array_release(matrix%col_blk_size)
         CALL array_release(matrix%row_blk_offset)
         CALL array_release(matrix%col_blk_offset)
         CALL dbcsr_distribution_release(matrix%dist)
         CALL dbcsr_release_locals(matrix)
         matrix%valid = .FALSE.
         matrix%refcount = 0
      END IF
      CALL timestop(error_handle)
   END SUBROUTINE dbcsr_destroy

   SUBROUTINE dbcsr_distribution_release(dist)
      !! Releases and potentially destroys a distribution
      TYPE(dbcsr_distribution_obj), INTENT(INOUT)        :: dist

!   ---------------------------------------------------------------------------

      IF (ASSOCIATED(dist%d)) THEN
         dist%d%refcount = dist%d%refcount - 1
         IF (dist%d%refcount .EQ. 0) THEN
            CALL array_release(dist%d%row_dist_block)
            CALL array_release(dist%d%col_dist_block)
            CALL array_release(dist%d%local_rows)
            CALL array_release(dist%d%local_cols)
            CALL dbcsr_mp_release(dist%d%mp_env)
            IF (dist%d%has_thread_dist) &
               CALL array_release(dist%d%thread_dist)
            CALL array_release(dist%d%row_map)
            CALL array_release(dist%d%col_map)
            CALL dbcsr_dist_release_locals(dist)
            DEALLOCATE (dist%d)
         END IF
      END IF
   END SUBROUTINE dbcsr_distribution_release

   SUBROUTINE dbcsr_dist_release_locals(dist)
      TYPE(dbcsr_distribution_obj), INTENT(INOUT)        :: dist

      INTEGER                                            :: i

      IF (dist%d%has_other_l_rows) THEN
         DO i = LBOUND(dist%d%other_l_rows, 1), UBOUND(dist%d%other_l_rows, 1)
            CALL array_release(dist%d%other_l_rows(i))
         END DO
         DEALLOCATE (dist%d%other_l_rows)
      END IF
      IF (dist%d%has_other_l_cols) THEN
         DO i = LBOUND(dist%d%other_l_cols, 1), UBOUND(dist%d%other_l_cols, 1)
            CALL array_release(dist%d%other_l_cols(i))
         END DO
         DEALLOCATE (dist%d%other_l_cols)
      END IF
      IF (dist%d%has_global_row_map) THEN
         CALL array_release(dist%d%global_row_map)
      END IF
      IF (dist%d%has_global_col_map) THEN
         CALL array_release(dist%d%global_col_map)
      END IF
      dist%d%has_other_l_rows = .FALSE.
      dist%d%has_other_l_cols = .FALSE.
      dist%d%has_global_row_map = .FALSE.
      dist%d%has_global_col_map = .FALSE.
   END SUBROUTINE dbcsr_dist_release_locals

   SUBROUTINE dbcsr_mp_release(mp_env)
      !! Releases and potentially destroys an mp_env

      TYPE(dbcsr_mp_obj), INTENT(INOUT)                  :: mp_env
         !! multiprocessor environment

!   ---------------------------------------------------------------------------

      IF (ASSOCIATED(mp_env%mp)) THEN
         mp_env%mp%refcount = mp_env%mp%refcount - 1
         IF (mp_env%mp%refcount .LE. 0) THEN
            CALL dbcsr_mp_grid_remove(mp_env)
            DEALLOCATE (mp_env%mp%pgrid)
            DEALLOCATE (mp_env%mp)
         END IF
      END IF
   END SUBROUTINE dbcsr_mp_release

   SUBROUTINE dbcsr_mp_grid_remove(mp_env)
      !! Removes an MPI cartesian process grid

      TYPE(dbcsr_mp_obj), INTENT(INOUT)                  :: mp_env
         !! multiprocessor environment

      IF (mp_env%mp%subgroups_defined) THEN
         CALL mp_comm_free(mp_env%mp%prow_group)
         CALL mp_comm_free(mp_env%mp%pcol_group)
      END IF
   END SUBROUTINE dbcsr_mp_grid_remove

   SUBROUTINE dbcsr_release_locals(matrix)
      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix

      IF (matrix%has_local_rows) &
         CALL array_release(matrix%local_rows)
      IF (matrix%has_global_rows) &
         CALL array_release(matrix%global_rows)
      IF (matrix%has_local_cols) &
         CALL array_release(matrix%local_cols)
      IF (matrix%has_global_cols) &
         CALL array_release(matrix%global_cols)
      matrix%has_local_rows = .FALSE.
      matrix%has_global_rows = .FALSE.
      matrix%has_local_cols = .FALSE.
      matrix%has_global_cols = .FALSE.
   END SUBROUTINE dbcsr_release_locals

!  SUBROUTINE dbcsr_release_vlocals (matrix)
!    TYPE(dbcsr_type), INTENT(INOUT)           :: matrix
!
!    IF (matrix%has_local_vrows) &
!         CALL array_release (matrix%local_vrows)
!    IF (matrix%has_global_vrows) &
!         CALL array_release (matrix%global_vrows)
!    IF (matrix%has_local_vcols) &
!         CALL array_release (matrix%local_vcols)
!    IF (matrix%has_global_vcols) &
!         CALL array_release (matrix%global_vcols)
!    matrix%has_local_vrows  = .FALSE.
!    matrix%has_global_vrows = .FALSE.
!    matrix%has_local_vcols  = .FALSE.
!    matrix%has_global_vcols = .FALSE.
!  END SUBROUTINE dbcsr_release_vlocals
!

! Pertaining to the dbcsr matrix.

   FUNCTION dbcsr_nblkrows_total(matrix) RESULT(nblkrows_total)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: nblkrows_total

      nblkrows_total = matrix%nblkrows_total
   END FUNCTION dbcsr_nblkrows_total

   FUNCTION dbcsr_nblkcols_total(matrix) RESULT(nblkcols_total)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: nblkcols_total

      nblkcols_total = matrix%nblkcols_total
   END FUNCTION dbcsr_nblkcols_total
   FUNCTION dbcsr_nfullrows_total(matrix) RESULT(nfullrows_total)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: nfullrows_total

      nfullrows_total = matrix%nfullrows_total
   END FUNCTION dbcsr_nfullrows_total
   FUNCTION dbcsr_nfullcols_total(matrix) RESULT(nfullcols_total)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: nfullcols_total

      nfullcols_total = matrix%nfullcols_total
   END FUNCTION dbcsr_nfullcols_total
   FUNCTION dbcsr_nblkrows_local(matrix) RESULT(nblkrows_local)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: nblkrows_local

      nblkrows_local = matrix%nblkrows_local
   END FUNCTION dbcsr_nblkrows_local
   FUNCTION dbcsr_nblkcols_local(matrix) RESULT(nblkcols_local)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: nblkcols_local

      nblkcols_local = matrix%nblkcols_local
   END FUNCTION dbcsr_nblkcols_local
   FUNCTION dbcsr_nfullrows_local(matrix) RESULT(nfullrows_local)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: nfullrows_local

      nfullrows_local = matrix%nfullrows_local
   END FUNCTION dbcsr_nfullrows_local
   FUNCTION dbcsr_nfullcols_local(matrix) RESULT(nfullcols_local)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: nfullcols_local

      nfullcols_local = matrix%nfullcols_local
   END FUNCTION dbcsr_nfullcols_local
   FUNCTION dbcsr_max_row_size(matrix) RESULT(max_row_size)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: max_row_size

      max_row_size = matrix%max_rbs
   END FUNCTION dbcsr_max_row_size
   FUNCTION dbcsr_max_col_size(matrix) RESULT(max_col_size)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER                                            :: max_col_size

      max_col_size = matrix%max_cbs
   END FUNCTION dbcsr_max_col_size

   FUNCTION dbcsr_distribution(matrix) RESULT(distribution)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      TYPE(dbcsr_distribution_obj)                       :: distribution

      distribution = matrix%dist
   END FUNCTION dbcsr_distribution

   FUNCTION dbcsr_name(matrix) RESULT(name)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      CHARACTER(len=default_string_length)               :: name

      name = matrix%name
   END FUNCTION dbcsr_name

   SUBROUTINE dbcsr_setname(matrix, newname)
      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
      CHARACTER(len=*), INTENT(IN)                       :: newname

      matrix%name = newname
   END SUBROUTINE dbcsr_setname

   PURE FUNCTION dbcsr_wm_use_mutable(wm) RESULT(use_mutable)
      !! Returns whether this work matrix uses the mutable type

      TYPE(dbcsr_work_type), INTENT(IN)                  :: wm
         !! work matrix
      LOGICAL                                            :: use_mutable
         !! use the mutable and not append-only working structures

!   ---------------------------------------------------------------------------

      use_mutable = dbcsr_mutable_instantiated(wm%mutable)
   END FUNCTION dbcsr_wm_use_mutable

   PURE FUNCTION dbcsr_use_mutable(matrix) RESULT(use_mutable)
      !! Returns whether work matrices should use the mutable data type

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! matrix
      LOGICAL                                            :: use_mutable
         !! use the mutable and not append-only working structures

!   ---------------------------------------------------------------------------

      use_mutable = matrix%work_mutable
   END FUNCTION dbcsr_use_mutable

   FUNCTION dbcsr_row_block_sizes(matrix) RESULT(row_blk_sizes)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: row_blk_sizes

      row_blk_sizes => array_data(matrix%row_blk_size)
   END FUNCTION dbcsr_row_block_sizes

   FUNCTION dbcsr_col_block_sizes(matrix) RESULT(col_blk_sizes)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: col_blk_sizes

      col_blk_sizes => array_data(matrix%col_blk_size)
   END FUNCTION dbcsr_col_block_sizes

   FUNCTION dbcsr_col_block_offsets(matrix) RESULT(col_blk_offsets)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: col_blk_offsets

      col_blk_offsets => array_data(matrix%col_blk_offset)
   END FUNCTION dbcsr_col_block_offsets

   FUNCTION dbcsr_row_block_offsets(matrix) RESULT(row_blk_offsets)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: row_blk_offsets

      row_blk_offsets => array_data(matrix%row_blk_offset)
   END FUNCTION dbcsr_row_block_offsets

   PURE FUNCTION dbcsr_blk_row_size(matrix, row) RESULT(row_size)
      !! Returns the blocked row size of a row
      !! This routine is optimized for speed and no checks are performed.

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! DBCSR matrix
      INTEGER, INTENT(IN)                                :: row
         !! row number
      INTEGER                                            :: row_size
         !! blocked row size

      row_size = matrix%row_blk_size%low%data(row)
   END FUNCTION dbcsr_blk_row_size

   PURE FUNCTION dbcsr_blk_row_offset(matrix, row) RESULT(row_offset)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER, INTENT(IN)                                :: row
      INTEGER                                            :: row_offset

      row_offset = matrix%row_blk_offset%low%data(row)
   END FUNCTION dbcsr_blk_row_offset

   PURE FUNCTION dbcsr_blk_column_size(matrix, column) RESULT(column_size)
      !! Returns the blocked column size of a column
      !! This routine is optimized for speed and no checks are performed.

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! DBCSR matrix
      INTEGER, INTENT(IN)                                :: column
         !! column number
      INTEGER                                            :: column_size
         !! blocked row size

      column_size = matrix%col_blk_size%low%data(column)
   END FUNCTION dbcsr_blk_column_size

   PURE FUNCTION dbcsr_blk_col_offset(matrix, col) RESULT(col_offset)
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
      INTEGER, INTENT(IN)                                :: col
      INTEGER                                            :: col_offset

      col_offset = matrix%col_blk_offset%low%data(col)
   END FUNCTION dbcsr_blk_col_offset

   FUNCTION dbcsr_data_area(matrix) RESULT(data_area)
      !! Returns the data area

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! matrix from which to get data
      TYPE(dbcsr_data_obj)                               :: data_area
         !! data area

      data_area = matrix%data_area
   END FUNCTION dbcsr_data_area

   PURE FUNCTION dbcsr_get_matrix_type(matrix) RESULT(matrix_type)
      !! Returns the matrix type

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! query this matrix
      CHARACTER                                          :: matrix_type
         !! matrix_type (see dbcsr_types.F for possible values)

      matrix_type = dbcsr_type_invalid
      IF (matrix%symmetry) THEN
         IF ((.NOT. matrix%negate_real) .AND. matrix%negate_imaginary) THEN
            matrix_type = dbcsr_type_hermitian
         ELSEIF (matrix%negate_real .AND. (.NOT. matrix%negate_imaginary)) THEN
            matrix_type = dbcsr_type_antihermitian
         ELSEIF (matrix%negate_real .AND. matrix%negate_imaginary) THEN
            matrix_type = dbcsr_type_antisymmetric
         ELSEIF ((.NOT. matrix%negate_real) .AND. (.NOT. matrix%negate_imaginary)) THEN
            matrix_type = dbcsr_type_symmetric
         END IF
      ELSE
         matrix_type = dbcsr_type_no_symmetry
      END IF
   END FUNCTION dbcsr_get_matrix_type

   PURE FUNCTION dbcsr_has_symmetry(matrix) RESULT(has_symmetry)
      !! Whether matrix has symmetry

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! query this matrix
      LOGICAL                                            :: has_symmetry
         !! matrix has symmetry

      has_symmetry = matrix%symmetry
   END FUNCTION dbcsr_has_symmetry

   PURE FUNCTION dbcsr_get_replication_type(matrix) RESULT(repl_type)
      !! Returns the data type stored in the matrix

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! query this matrix
      CHARACTER                                          :: repl_type
         !! repl_type (see dbcsr_types.F for possible values)

      repl_type = matrix%replication_type
   END FUNCTION dbcsr_get_replication_type

   PURE FUNCTION dbcsr_get_data_type(matrix) RESULT(data_type)
      !! Returns the data type stored in the matrix

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! query this matrix
      INTEGER                                            :: data_type
         !! data_type (see dbcsr_types.F for possible values)

      data_type = matrix%data_type
   END FUNCTION dbcsr_get_data_type

   FUNCTION dbcsr_get_data_memory_type(matrix) &
      RESULT(memory_type)
      !! Returns the type of memory used for data in the matrix
      !! @note It returns the declared data type, not the actually used type

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! query this matrix
      TYPE(dbcsr_memtype_type)                           :: memory_type
         !! memory type used for data

      memory_type = matrix%data_memory_type
   END FUNCTION dbcsr_get_data_memory_type

   FUNCTION dbcsr_get_index_memory_type(matrix) RESULT(memory_type)
      !! Returns the type of memory used for the index in the matrix

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! query this matrix
      TYPE(dbcsr_memtype_type)                           :: memory_type
         !! memory type used for the index

      memory_type = matrix%index_memory_type
   END FUNCTION dbcsr_get_index_memory_type

!  PURE FUNCTION uses_special_memory_matrix (matrix) RESULT (uses_special)
!   !! Returns whether the matrix uses specially-allocated memory
!    TYPE(dbcsr_type), INTENT(IN)              :: matrix
!       !! query this matrix
!    LOGICAL                                  :: uses_special
!       !! whether the matrix uses specially allocated memory
!
!    uses_special = matrix%data_memory_type .NE. dbcsr_memory_default
!  END FUNCTION uses_special_memory_matrix
!
!
!  PURE FUNCTION uses_special_memory_area (area) RESULT (uses_special)
!    !! Returns whether the data area uses special-allocated memory
!    TYPE(dbcsr_data_obj), INTENT(IN)         :: area
!       !! query this data area
!    LOGICAL                                  :: uses_special
!       !! whether the data area uses specially allocated memory
!
!    IF (ASSOCIATED (area%d)) THEN
!       uses_special = area%d%memory_type .NE. dbcsr_memory_default
!    ELSE
!       uses_special = .FALSE.
!    ENDIF
!  END FUNCTION uses_special_memory_area
!

   FUNCTION dbcsr_get_data_size(matrix) RESULT(data_size)
      !! Returns the allocated data size of a DBCSR matrix

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! matrix
      INTEGER                                            :: data_size
         !! size of data

      INTEGER                                            :: data_type

      data_size = 0
      data_type = dbcsr_get_data_type(matrix)
      IF (data_type .NE. dbcsr_type_real_8 .AND. &
          data_type .NE. dbcsr_type_real_4 .AND. &
          data_type .NE. dbcsr_type_complex_8 .AND. &
          data_type .NE. dbcsr_type_complex_4) DBCSR_ABORT("Incorrect data type")
      data_size = dbcsr_data_get_size(matrix%data_area)
   END FUNCTION dbcsr_get_data_size

   FUNCTION dbcsr_get_data_size_used(matrix) RESULT(data_size)
      !! Count actual data storage used for matrix data.

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! Count data of this matrix
      INTEGER                                            :: data_size
         !! Data size used by matrix

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_get_data_size_used'

      INTEGER                                            :: blk, col, error_handle, nze, row
      INTEGER, DIMENSION(:), POINTER                     :: col_blk_sizes, row_blk_sizes

!type(dbcsr_iterator_type) :: iter
!   ---------------------------------------------------------------------------

      CALL timeset(routineN, error_handle)
      row_blk_sizes => dbcsr_row_block_sizes(matrix)
      col_blk_sizes => dbcsr_col_block_sizes(matrix)
      data_size = 0
!$OMP     DO
      DO row = 1, matrix%nblkrows_total
         DO blk = matrix%row_p(row) + 1, matrix%row_p(row + 1)
            col = matrix%col_i(blk)
            IF (matrix%blk_p(blk) .NE. 0) THEN
               nze = row_blk_sizes(row)*col_blk_sizes(col)
               data_size = data_size + nze
            END IF
         END DO
      END DO
!$OMP     END DO
      CALL timestop(error_handle)
   END FUNCTION dbcsr_get_data_size_used

   PURE FUNCTION dbcsr_get_num_blocks(matrix) RESULT(num_blocks)
      !! Returns the number of blocks in the matrix

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! matrix from which to get data
      INTEGER                                            :: num_blocks

      num_blocks = matrix%nblks
   END FUNCTION dbcsr_get_num_blocks

   PURE FUNCTION dbcsr_get_nze(matrix) RESULT(num_nze)
      !! Returns the number of non-zero elements in the matrix

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! matrix from which to get data
      INTEGER                                            :: num_nze

      num_nze = matrix%nze
   END FUNCTION dbcsr_get_nze

! **************************************************************************************************
! Arrays
! **************************************************************************************************

   SUBROUTINE dbcsr_destroy_1d_array(marray)
      !! Releases all matrices in a 1-d array.

      TYPE(dbcsr_1d_array_type), INTENT(INOUT)           :: marray
         !! matrix array

      INTEGER                                            :: i

!   ---------------------------------------------------------------------------

      DO i = LBOUND(marray%mats, 1), UBOUND(marray%mats, 1)
         CALL dbcsr_destroy(marray%mats(i), force=.TRUE.)
      END DO
      CALL dbcsr_image_dist_release(marray%image_dist)
      DEALLOCATE (marray%mats)
   END SUBROUTINE dbcsr_destroy_1d_array

   SUBROUTINE dbcsr_destroy_2d_array(marray)
      !! Releases all matrices in 2-d array.

      TYPE(dbcsr_2d_array_type), INTENT(INOUT)           :: marray
         !! matrix array

      INTEGER                                            :: col, row

!   ---------------------------------------------------------------------------

      DO row = LBOUND(marray%mats, 1), UBOUND(marray%mats, 1)
         DO col = LBOUND(marray%mats, 2), UBOUND(marray%mats, 2)
            CALL dbcsr_destroy(marray%mats(row, col), force=.TRUE.)
         END DO
      END DO
      CALL dbcsr_image_dist_release(marray%image_dist)
      DEALLOCATE (marray%mats)
   END SUBROUTINE dbcsr_destroy_2d_array

   SUBROUTINE dbcsr_image_dist_release(imgdist)
      !! Releases a reference to and possible deallocates an image
      !! distribution

      TYPE(dbcsr_imagedistribution_obj), INTENT(INOUT)   :: imgdist

      IF (ASSOCIATED(imgdist%i)) THEN
         imgdist%i%refcount = imgdist%i%refcount - 1
         IF (imgdist%i%refcount .EQ. 0) THEN
            CALL dbcsr_destroy_image_dist(imgdist%i)
            DEALLOCATE (imgdist%i)
         END IF
      END IF
   END SUBROUTINE dbcsr_image_dist_release

   SUBROUTINE dbcsr_image_dist_hold(imgdist)
      !! Retains a reference to an image distribution
      TYPE(dbcsr_imagedistribution_obj), INTENT(INOUT)   :: imgdist

      imgdist%i%refcount = imgdist%i%refcount + 1
   END SUBROUTINE dbcsr_image_dist_hold

   SUBROUTINE dbcsr_image_dist_init(imgdist)
      !! Initialized an image distribution
      !!
      !! Akin to nullify.

      TYPE(dbcsr_imagedistribution_obj), INTENT(OUT)     :: imgdist

      NULLIFY (imgdist%i)
   END SUBROUTINE dbcsr_image_dist_init

   SUBROUTINE dbcsr_destroy_image_dist(imgdist)
      !! Destroys a DBCSR distribution for a matrix multiplication based on
      !! the right matrix

      TYPE(dbcsr_imagedistribution_type), INTENT(INOUT)  :: imgdist
         !! product distribution repetition

      INTEGER                                            :: i

!   ---------------------------------------------------------------------------

      CALL array_release(imgdist%row_image)
      CALL array_release(imgdist%col_image)
      CALL dbcsr_distribution_release(imgdist%main)
      !
      CALL array_release(imgdist%vrow_dist)
      CALL array_release(imgdist%vcol_dist)
      !
      IF (imgdist%has_other_vl_rows) THEN
         DO i = LBOUND(imgdist%other_vl_rows, 1), UBOUND(imgdist%other_vl_rows, 1)
            CALL array_release(imgdist%other_vl_rows(i))
         END DO
         DEALLOCATE (imgdist%other_vl_rows)
         imgdist%has_other_vl_rows = .FALSE.
      END IF
      !
      IF (imgdist%has_other_vl_cols) THEN
         DO i = LBOUND(imgdist%other_vl_cols, 1), UBOUND(imgdist%other_vl_cols, 1)
            CALL array_release(imgdist%other_vl_cols(i))
         END DO
         DEALLOCATE (imgdist%other_vl_cols)
         imgdist%has_other_vl_cols = .FALSE.
      END IF
      !
      IF (imgdist%has_global_vrow_map) THEN
         CALL array_release(imgdist%global_vrow_map)
      END IF
      IF (imgdist%has_global_vcol_map) THEN
         CALL array_release(imgdist%global_vcol_map)
      END IF
   END SUBROUTINE dbcsr_destroy_image_dist

! **************************************************************************************************
! Mutable data
! **************************************************************************************************

   SUBROUTINE dbcsr_mutable_init(mutable)
      !! Initializes a mutable data type

      TYPE(dbcsr_mutable_obj), INTENT(OUT)               :: mutable
         !! mutable data

      NULLIFY (mutable%m)
   END SUBROUTINE dbcsr_mutable_init

   SUBROUTINE dbcsr_mutable_destroy(mutable)
      !! Destroys a mutable data type

      TYPE(dbcsr_mutable_obj), INTENT(INOUT)             :: mutable
         !! mutable data

!   ---------------------------------------------------------------------------

      IF (ASSOCIATED(mutable%m)) THEN
         CALL btree_delete(mutable%m%btree_s)
         CALL btree_delete(mutable%m%btree_d)
         CALL btree_delete(mutable%m%btree_c)
         CALL btree_delete(mutable%m%btree_z)
         DEALLOCATE (mutable%m)
      END IF
      NULLIFY (mutable%m)
   END SUBROUTINE dbcsr_mutable_destroy

   SUBROUTINE dbcsr_mutable_release(mutable)
      !! Unregisters a reference to the mutable data type
      !! The object is destroy when there is no reference to it left.

      TYPE(dbcsr_mutable_obj), INTENT(INOUT)             :: mutable
         !! mutable data

!   ---------------------------------------------------------------------------

      IF (.NOT. ASSOCIATED(mutable%m)) &
         DBCSR_ABORT("Mutable data area not instantiated")
      mutable%m%refcount = mutable%m%refcount - 1
      IF (mutable%m%refcount .EQ. 0) THEN
         CALL dbcsr_mutable_destroy(mutable)
      END IF
   END SUBROUTINE dbcsr_mutable_release

   SUBROUTINE dbcsr_mutable_new(mutable, data_type)
      !! Creates a new mutable instance.

      TYPE(dbcsr_mutable_obj), INTENT(INOUT)             :: mutable
         !! mutable data
      INTEGER, INTENT(IN)                                :: data_type
         !! data type to be stored here (see dbcsr_types for possibilities)

!   ---------------------------------------------------------------------------

      IF (ASSOCIATED(mutable%m)) &
         DBCSR_ABORT("Mutable data area already instantiated")
      IF (data_type .NE. dbcsr_type_real_4 &
          .AND. data_type .NE. dbcsr_type_real_8 &
          .AND. data_type .NE. dbcsr_type_complex_4 &
          .AND. data_type .NE. dbcsr_type_complex_8) &
         DBCSR_ABORT("Invalid data type")
      ALLOCATE (mutable%m)
      mutable%m%refcount = 1
      mutable%m%data_type = data_type
      CALL btree_new(mutable%m%btree_s)
      CALL btree_new(mutable%m%btree_d)
      CALL btree_new(mutable%m%btree_c)
      CALL btree_new(mutable%m%btree_z)
   END SUBROUTINE dbcsr_mutable_new

   PURE FUNCTION dbcsr_mutable_instantiated(mutable) RESULT(instantiated)
      !! Unregisters a reference to the mutable data type
      !! The object is destroy when there is no reference to it left.

      TYPE(dbcsr_mutable_obj), INTENT(IN)                :: mutable
         !! mutable data
      LOGICAL                                            :: instantiated
         !! whether the object is instantiated

!   ---------------------------------------------------------------------------

      instantiated = ASSOCIATED(mutable%m)
   END FUNCTION dbcsr_mutable_instantiated

END MODULE dbcsr_methods
